﻿Imports System.Reflection

<ComClass(ClsLwPolyLine.ClassId, ClsLwPolyLine.InterfaceId, ClsLwPolyLine.EventsId)>
Public Class ClsLwPolyLine

#Region "COM GUID"
    ' 这些 GUID 提供此类的 COM 标识 
    ' 及其 COM 接口。若更改它们，则现有的
    ' 客户端将不再能访问此类。
    Public Const ClassId As String = "c6d28a1a-3d35-4ef8-be63-0ddc7f9acee1"
    Public Const InterfaceId As String = "96e04372-79c7-4dca-9f93-f8291a818e82"
    Public Const EventsId As String = "afc27a33-35ec-42e9-bcd2-c5291f502a27"
#End Region

    ' 可创建的 COM 类必须具有一个不带参数的 Public Sub New() 
    ' 否则， 将不会在 
    ' COM 注册表中注册此类，且无法通过
    ' CreateObject 创建此类。
    Public Sub New()
        MyBase.New()
    End Sub

#Region "属性和字段"

    Private _vertexs As ClsLwPolylineVertex()

    Public Property Vertexs() As ClsLwPolylineVertex()
        Get
            Return _vertexs
        End Get
        Set(ByVal value As ClsLwPolylineVertex())
            _vertexs = value
        End Set
    End Property

    Public ReadOnly Property HasBulges As Boolean
        Get
            Return Me.Vertexs.ToArray().Count(Function(c) Math.Abs(c.Bulge) < 0.00000001) > 0
        End Get
    End Property

    Public ReadOnly Property IsOnlyLines As Boolean
        Get
            Return Not Me.HasBulges
        End Get
    End Property

    Public ReadOnly Property Closed As Boolean
        Get
            Dim vertex = Me.Vertexs(0)
            vertex = Me.Vertexs((Me.Vertexs.Count - 1))
            Return vertex.Position.IsEqualTo(vertex.Position)
        End Get
    End Property

    ''' <summary>
    ''' 多变形长度计算
    ''' </summary>
    ''' <returns></returns>

    Public ReadOnly Property Length As Double
        Get
            Dim l As Double = 0, MathHelper As New ClsMath
            For i = 1 To Me.Vertexs.Count - 1
                l += Me.Vertexs(i - 1).Position.GetDistanceTo(Me.Vertexs(i).Position)
            Next i

            If Not Me.IsOnlyLines Then
                Dim i As Integer = 0
                Do While (i <= Me.Vertexs.Count - 1)
                    Dim vertex = Me.Vertexs(i) '当前节点
                    If (Math.Abs(vertex.Bulge) >= 0.00000001) Then

                        Dim vNext As ClsPoint2d
                        If i < Me.Vertexs.Count - 1 Then
                            vNext = Me.Vertexs(i + 1).Position
                        Else
                            If Me.Closed Then
                                vNext = Me.Vertexs(0).Position
                            Else
                                vNext = Me.Vertexs(i).Position
                            End If
                        End If
                        Dim cpnt As ClsPoint2d = MathHelper.GetArcCenter(vertex.Position, vNext, vertex.Bulge) ' //圆心坐标
                        l += (cpnt.GetDistanceTo(vertex.Position) * Math.Abs(CDbl((Math.Atan(vertex.Bulge) * 4)))) '//弧长等于半径*圆心角的度数
                        '//当前点与下一点的距离需要扣除
                        '//如果多边形不闭合(起点与末点重合),最后点与第一点的长度第一次未计算,所以不需要计算
                        l -= vertex.Position.GetDistanceTo(vNext)
                    End If
                    i += 1
                Loop
            End If
            Return l
        End Get
    End Property

    ''' <summary>
    ''' 多段线的点的转动方向
    ''' </summary>
    ''' <returns></returns>
    ''' 
    Public ReadOnly Property Direction As 旋转方向
        Get
            Dim a As Double = 0
            For i = 0 To Me.Vertexs.Count - 1
                Dim voi As ClsVector2d = Me.Vertexs(i).Position.GetAsVector2d()
                Dim voi1 As ClsVector2d
                If i < (Me.Vertexs.Count - 1) Then
                    voi1 = Me.Vertexs((i + 1)).Position.GetAsVector2d()
                Else
                    voi1 = Me.Vertexs(0).Position.GetAsVector2d()

                End If
                a += voi.CrossProductWith(voi1)
            Next i
            Return IIf(a < 0, 旋转方向.ClockWise, 旋转方向.CounterClockWise)
        End Get
    End Property

    ''' <summary>
    ''' 多边形几何中心的算法
    ''' </summary>
    ''' <returns>有bug未考虑圆弧部分</returns>
    Public ReadOnly Property GravityCenter As ClsPoint2d
        Get
            Dim gc As New ClsPoint2d
            Dim totalArea = 0#, totalX = 0#, totalY = 0#
            For i = 0 To Me.Vertexs.Length - 2
                Dim voi = Me.Vertexs(i).Position.GetAsVector2d()
                Dim voi1 = Me.Vertexs(i + 1).Position.GetAsVector2d()
                Dim Area = voi.CrossProductWith(voi1) * 0.5
                Dim x1 = (Me.Vertexs(i).Position.X + Me.Vertexs(i + 1).Position.X) / 3
                Dim y1 = (Me.Vertexs(i).Position.Y + Me.Vertexs(i + 1).Position.Y) / 3
                totalX += Area * x1
                totalY += Area * y1
                totalArea += Area
            Next
            gc.X = totalX / totalArea
            gc.Y = totalY / totalArea
            Return gc
        End Get
    End Property
    ''' <summary>
    ''' 多段线的面积算法
    ''' </summary>
    ''' <returns></returns>
    Public ReadOnly Property Area As Double
        Get
            Dim MathHelper As New ClsMath
            Dim a As Double = 0
            '不考虑凸度,先计算全部直线段的面积
            For i = 0 To Me.Vertexs.Count - 1
                Dim voi As ClsVector2d = Me.Vertexs(i).Position.GetAsVector2d()
                Dim voi1 As ClsVector2d
                If i < Me.Vertexs.Count - 1 Then
                    voi1 = Me.Vertexs(i + 1).Position.GetAsVector2d()
                Else
                    voi1 = Me.Vertexs(0).Position.GetAsVector2d()
                End If
                a += voi.CrossProductWith(voi1)
            Next i

            '修正有圆弧的部分的面积
            a = IIf((a < 0), ((a * 0.5) * -1), (a * 0.5))

            If Not Me.IsOnlyLines Then
                For i = 0 To Me.Vertexs.Count - 1
                    If (Math.Abs(Me.Vertexs(i).Bulge) > 0.00000001) Then

                        Dim vNext As ClsPoint2d
                        If i < Me.Vertexs.Count - 1 Then
                            vNext = Me.Vertexs((i + 1)).Position
                        Else
                            vNext = Me.Vertexs(0).Position
                        End If

                        Dim cpnt As ClsPoint2d = MathHelper.GetArcCenter(Me.Vertexs(i).Position, vNext, Me.Vertexs(i).Bulge) '//圆心坐标

                        Dim 弦长 As Double = Me.Vertexs(i).Position.GetDistanceTo(vNext) '// 弦长

                        Dim 半径 As Double = cpnt.GetDistanceTo(Me.Vertexs(i).Position)
                        Dim 弓高 As Double = ((0.5 * Math.Abs(Me.Vertexs(i).Bulge)) * 弦长) '//2，凸度等于圆弧的弓高和圆弧的前进距离的比，即凸度=2H/L，H为弓高，L为前进的长度，也即弦长。
                        Dim 扇形面积 As Double = (0.5 * 半径 * 半径) * 4 * Math.Atan(Math.Abs(Me.Vertexs(i).Bulge))
                        '//当弓形弧是劣弧时，三角形的高=半径-弓形高；（2）当弓形弧是优弧时，三角形的高=半径+弓形高． 
                        Dim 三角形面积 As Double = (0.5 * ((弓高 * IIf((Math.Abs(Me.Vertexs(i).Bulge) > 1), CDbl(1), CDbl(-1))) + 半径)) * 弦长
                        ' //当弓形弧是劣弧时，S弓形＝S扇形－S三角形；（2）当弓形弧是优弧时，S弓形＝S扇形＋S三角形． 
                        Dim 弓形面积 As Double = 扇形面积 + (IIf((Math.Abs(Me.Vertexs(i).Bulge) > 1), CDbl(1), CDbl(-1)) * 三角形面积) '
                        a += IIf(Me.Direction = 旋转方向.ClockWise, IIf((Me.Vertexs(i).Bulge < 0), 弓形面积, (弓形面积 * -1)), IIf((Me.Vertexs(i).Bulge > 0), 弓形面积, 弓形面积 * -1))
                    End If
                Next i
            End If
            Return a
        End Get
    End Property

    Public ReadOnly Property BoundingBox As ClsRectangle

        Get
            Dim maxX = Me.Vertexs.Select(Function(c) c.Position.X).Max()
            Dim minX = Me.Vertexs.Select(Function(c) c.Position.X).Min()
            Dim maxY = Me.Vertexs.Select(Function(c) c.Position.Y).Max()
            Dim minY = Me.Vertexs.Select(Function(c) c.Position.Y).Min()

            Dim recCe = New ClsPoint2d With {.X = 0.5 * (maxX + minX), .Y = 0.5 * (maxY + minY)}
            Dim w = maxX - minX
            Dim h = maxY - minY
            Dim rec As New ClsRectangle
            If w > h Then
                rec.Creator(recCe, h, w, 0)
            Else
                rec.Creator(recCe, w, h, Math.PI * 0.5)

            End If
            Return rec
        End Get
    End Property

#End Region

#Region "构造函数和方法"

    ''' <summary>
    ''' 节点增加值
    ''' </summary>
    ''' <param name="vertex">节点</param>
    ''' <param name="index">默认增加到最后一个元素</param>
    Public Sub AddVertexAt(ByVal vertex As ClsLwPolylineVertex, ByVal Optional index As Integer = 0)
        Dim list = Me.Vertexs.ToList()
        If (index > 0) Then
            list.Insert(index, vertex)
        Else
            list.Add(vertex)
        End If
        Me.Vertexs = list.ToArray()
    End Sub

    Public Function GetVertexAt(ByVal index As Integer) As ClsLwPolylineVertex
        Return Me.Vertexs(index)
    End Function

    Public Sub New(ByVal listvertexs() As ClsLwPolylineVertex)
        Me.Vertexs = listvertexs
    End Sub


    Public Sub RotateTo(ByVal angle As Double, ByVal rotatePoint As ClsPoint2d)
        For index = 0 To Me.Vertexs.Length - 1
            Dim c As ClsLwPolylineVertex = Me.Vertexs(index)
            c.Position.RotateTo(angle, rotatePoint)
        Next
    End Sub

    Public Sub MoveTo(ByVal fromPnt As ClsPoint2d, ByVal toPnt As ClsPoint2d)
        Dim v As ClsVector2d = fromPnt.GetVector2dTo(toPnt)

        For index = 0 To Me.Vertexs.Length - 1
            Dim c As ClsLwPolylineVertex = Me.Vertexs(index)
            c.Position.MoveTo(v)
        Next
    End Sub

    Public Sub MirrorTo(ByVal mirrorP1 As ClsPoint2d, ByVal mirrorP2 As ClsPoint2d)
        For index = 0 To Me.Vertexs.Length - 1
            Dim c As ClsLwPolylineVertex = Me.Vertexs(index)
            c.Position = c.Position.Mirror(mirrorP1, mirrorP2)
        Next
    End Sub

#End Region


#Region "与cad对象互相转化"

    Public Function CreateFromAcadObject(pline As Object) As Boolean
        If TypeName(pline) = "IAcadLWPolyline" Then
            Dim vertexpts As New List(Of ClsLwPolylineVertex)
            Dim ptsCount = (UBound(pline.Coordinates) + 1) / 2
            'MsgBox(ptsCount & "个节点")
            For index = 0 To ptsCount - 1
                vertexpts.Add(New ClsLwPolylineVertex() With
                    {
                        .Bulge = pline.GetBulge(index),
                        .Position = New ClsPoint2d() With {.X = pline.Coordinate(index)(0), .Y = pline.Coordinate(index)(1)}
                     }
                )
            Next
            Me.Vertexs = vertexpts.ToArray()
            Return True
        End If
        Return False
    End Function

    ''' <summary>
    ''' 在cad中画出多义线
    ''' </summary>
    ''' <param name="curLayout">modelspace or paperspace</param>
    ''' <param name="heightofthecompline"></param>
    ''' <returns>IAcadLWPolyline 的com对象</returns>
    Public Function DrawToAcad(curLayout As Object, Optional heightofthecompline As Double = 0) As Object
        Dim rtn = Nothing
        If curLayout.ObjectName <> "AcDbBlockTableRecord" Then Return rtn
        Dim verticesList(Me.Vertexs.Length * 2 - 1) As Double
        For i = 0 To Me.Vertexs.Length - 1
            verticesList(2 * i) = Me.Vertexs(i).Position.X
            verticesList(2 * i + 1) = Me.Vertexs(i).Position.Y
        Next
        rtn = curLayout.AddLightWeightPolyline(verticesList)

        For i = 0 To Me.Vertexs.Length - 1
            rtn.SetBulge(i, Me.Vertexs(i).Bulge)
        Next
        rtn.Elevation = heightofthecompline
        Return rtn
    End Function
#End Region


#Region "Clone"
    Public Function Clone() As ClsLwPolyLine

        Dim t As Type = Me.GetType()
        Dim setProps As List(Of PropertyInfo) = t.GetProperties.Where(Function(p) p.CanWrite).ToList()
        Dim rtnObj = Activator.CreateInstance(t)
        For Each p As PropertyInfo In setProps
            p.SetValue(rtnObj, p.GetValue(Me, Nothing), Nothing)
        Next
        Return DirectCast(rtnObj, ClsLwPolyLine)

    End Function

#End Region
End Class


